home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / Bonus / DBaldwin / htmllite.exe / help / htmllite.int < prev    next >
Encoding:
Text File  |  2001-06-24  |  17.6 KB  |  415 lines
  1. {Version 7.25a}
  2. {*********************************************************}
  3. {*                     HTMLLITE.PAS                      *}
  4. {*              Copyright (c) 1995-2000 by               *}
  5. {*                   L. David Baldwin                    *}
  6. {*                 All rights reserved.                  *}
  7. {*********************************************************}
  8.  
  9. {$i LiteCons.inc}
  10.  
  11. unit HTMLLite;
  12.  
  13. interface
  14.  
  15. uses
  16.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls, StdCtrls,
  17.   LiteUn2, Forms, Dialogs, ExtCtrls, LitePars, LiteSubs, Menus;
  18.  
  19. const
  20.   wm_FormSubmit = wm_User+100;
  21.   wm_MouseScroll = wm_User+102;
  22.  
  23. type
  24.   THTMLBorderStyle = (htFocused, htNone, htSingle);
  25.   TRightClickParameters = Class(TObject)
  26.     URL, Target: string;
  27.     Image: TImageObj;
  28.     ImageX, ImageY: integer;
  29.     ClickWord: string;
  30.     end;
  31.   TRightClickEvent = procedure(Sender: TObject; Parameters: TRightClickParameters) of Object;
  32.   THotSpotEvent = procedure(Sender: TObject; const SRC: string) of Object;
  33.   THotSpotClickEvent = procedure(Sender: TObject; const SRC: string;
  34.                      var Handled: boolean) of Object;
  35.   TProcessingEvent = procedure(Sender: TObject; ProcessingOn: boolean) of Object;
  36.   TImageClickEvent = procedure(Sender, Obj: TObject; Button: TMouseButton;
  37.                        Shift: TShiftState; X, Y: Integer) of Object;
  38.   TImageOverEvent = procedure(Sender, Obj: TObject; Shift: TShiftState;
  39.                        X, Y: Integer) of Object;
  40.   TMetaRefreshType = procedure(Sender: TObject; Delay: integer; const URL: string) of Object;
  41.  
  42.   htOptionEnum = (htOverLinksActive,htNoLinkUnderline, htShowDummyCaret, htShowVScroll);   
  43.   ThtmlViewerOptions = set of htOptionEnum;
  44.  
  45.   TPaintPanel = class(TCustomPanel)
  46.   private
  47.     FOnPaint: TNotifyEvent;
  48.     FViewer: TComponent;
  49.     Canvas2: TCanvas;
  50.     procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); message WM_EraseBkgnd;
  51.     procedure WMLButtonDblClk(var Message: TWMMouse); message WM_LButtonDblClk;
  52.     procedure DoBackground(ACanvas: TCanvas; WmErase: boolean);
  53.     constructor CreateIt(AOwner: TComponent; Viewer: TComponent);
  54.     property OnPaint: TNotifyEvent read FOnPaint write FOnPaint;
  55.   public
  56.     procedure Paint; override;
  57.   end;
  58.  
  59. {$ifdef Win32}
  60.   T32ScrollBar = Class(TScrollBar)   {a 32 bit scrollbar}
  61.   private
  62.     FPosition: integer;
  63.     FMin, FMax, FPage: integer;
  64.     procedure SetPosition(Value: integer);
  65.     procedure SetMin(Value: Integer);
  66.     procedure SetMax(Value: Integer);
  67.     procedure CNVScroll(var Message: TWMVScroll); message CN_VSCROLL;
  68.   public
  69.     property Position: integer read FPosition write SetPosition;
  70.     property Min: integer read FMin write SetMin;
  71.     property Max: integer read FMax write SetMax;
  72.     procedure SetParams(APosition, APage, AMin, AMax: Integer);
  73.   end;
  74. {$endif}
  75.  
  76.   ThtmlFileType = (HTMLType, TextType, ImgType, OtherType);
  77.  
  78.   ThtmlLite = class(TWinControl)
  79.   protected
  80.   KeepCanvas: boolean;  //{!!}
  81.     FOnDragDrop: TDragDropEvent;
  82.     FOnDragOver: TDragOverEvent;
  83.     function GetDragDrop: TDragDropEvent;
  84.     function GetDragOver: TDragOverEvent;
  85.     procedure SetDragDrop(const Value: TDragDropEvent);
  86.     procedure SetDragOver(const Value: TDragOverEvent);
  87.     procedure HTMLDragDrop(Sender, Source: TObject; X, Y: Integer);
  88.     procedure HTMLDragOver(Sender, Source: TObject; X, Y: Integer;
  89.       State: TDragState; var Accept: Boolean);
  90.   protected
  91.     { Private declarations }
  92.     DontDraw: boolean;
  93.     FTitle: PString;
  94.     FURL: PString;
  95.     FTarget: PString;
  96.     FBase, FBaseEx: PString;
  97.     FBaseTarget: PString;
  98.     FCurrentFile: PString;
  99.     FNameList: TStringList;
  100.     FCurrentFileType: ThtmlFileType;
  101.     FOnHotSpotCovered: THotSpotEvent;
  102.     FOnHotSpotClick: THotSpotClickEvent;
  103.     FOnImageRequest: TGetImageEvent;
  104.     FOnScript: TScriptEvent;
  105.     FOnFormSubmit: TFormSubmitEvent;
  106.     FOnHistoryChange: TNotifyEvent;
  107.     FOnProcessing: TProcessingEvent;
  108.     FOnInclude: TIncludeType;
  109.     FOnSoundRequest: TSoundType;
  110.     FOnMeta: TMetaType;
  111.     FOnMetaRefresh: TMetaRefreshType;
  112.     FRefreshURL: string;
  113.     FRefreshDelay: Integer;
  114.     FOnRightClick: TRightClickEvent;
  115.     FOnImageClick: TImageClickEvent;
  116.     FOnImageOver: TImageOverEvent;
  117.     FOnObjectClick: TObjectClickEvent;
  118.     FHistory, FTitleHistory: TStrings;
  119.     FPositionHistory: TFreeList;
  120.     FHistoryIndex: integer;
  121.     FHistoryMaxCount: integer;
  122.     FFontName: PString;
  123.     FPreFontName: PString;
  124.     FFontColor: TColor;
  125.     FHotSpotColor, FVisitedColor, FOverColor: TColor;
  126.     FVisitedMaxCount: integer;
  127.     FBackGround: TColor;
  128.     FFontSize: integer;
  129.     FProcessing: boolean;
  130.     FAction, FFormTarget, FEncType, FMethod: String;
  131.     FStringList: TStringList;
  132.     FImageCacheCount: integer;
  133.     FNoSelect: boolean;
  134.     FScrollBars: TScrollStyle;
  135.     FBorderStyle: THTMLBorderStyle;
  136.     FDither: boolean;
  137.     FCaretPos: LongInt;
  138.     FOptions: ThtmlViewerOptions;
  139.     sbWidth: integer;
  140.     ScrollWidth: integer;
  141.     MaxVertical: LongInt;
  142.     MouseScrolling: boolean;
  143.     LeftButtonDown: boolean;
  144.     MiddleScrollOn: boolean;
  145.     MiddleY: LongInt;
  146.     Hiliting: boolean;
  147.     {$ifdef ver100_plus}  {Delphi 3,4,5, C++Builder 3, 4}
  148.     FCharset: TFontCharset;
  149.     {$endif}
  150.     FPage: integer;
  151.     FOnMouseDouble: TMouseEvent;
  152.     HotSpotAction: boolean;
  153.     FMarginHeight, FMarginWidth: integer;
  154.     FServerRoot: string;
  155.     FSectionList: TSectionList;
  156.     FImageStream: TMemoryStream;
  157.     FOnExpandName: TExpandNameEvent;
  158.     HTMLTimer: TTimer;
  159.  
  160.     procedure WMSize(var Message: TWMSize); message WM_SIZE;
  161.     procedure ScrollTo(Y: LongInt);
  162.     procedure Scroll(Sender: TObject; ScrollCode: TScrollCode;
  163.            var ScrollPos: Integer);
  164.     procedure Layout;
  165.     procedure SetViewImages(Value: boolean);
  166.     function GetViewImages: boolean;
  167.     procedure SetColor(Value: TColor);
  168.     function GetBase: string;
  169.     procedure SetBase(Value: string);
  170.     function GetBaseTarget: string;
  171.     function GetFURL: string;
  172.     function GetTitle: string;
  173.     function GetCurrentFile: string;
  174.     procedure SetBorderStyle(Value: THTMLBorderStyle);
  175.     function GetPosition: LongInt;
  176.     procedure SetPosition(Value: LongInt);
  177.     function GetScrollPos: integer;
  178.     procedure SetScrollPos(Value: integer);
  179.     function GetScrollBarRange: integer;
  180.     procedure SetHistoryIndex(Value: integer);
  181.     function GetFontName: TFontName;
  182.     procedure SetFontName(Value: TFontName);
  183.     function GetPreFontName: TFontName;
  184.     procedure SetPreFontName(Value: TFontName);
  185.     procedure SetFontSize(Value: integer);
  186.     procedure SetFontColor(Value: TColor);
  187.     procedure SetHotSpotColor(Value: TColor);
  188.     procedure SetActiveColor(Value: TColor);
  189.     procedure SetVisitedColor(Value: TColor);
  190.     procedure SetVisitedMaxCount(Value: integer);
  191.     procedure SetOnImageRequest(Handler: TGetImageEvent);
  192.     procedure SetOnScript(Handler: TScriptEvent);
  193.     procedure SetOnFormSubmit(Handler: TFormSubmitEvent);
  194.     function GetOurPalette: HPalette;
  195.     procedure SetOurPalette(Value: HPalette);
  196.     procedure SetDither(Value: boolean);
  197.     procedure SetCaretPos(Value: LongInt);
  198.     procedure WMGetDlgCode(var Message: TMessage); message WM_GETDLGCODE;
  199.     procedure BackgroundChange(Sender: TObject);
  200.     procedure SubmitForm(Sender: TObject; const Action, Target, EncType, Method: string;
  201.                 Results: TStringList);
  202.     procedure SetImageCacheCount(Value: integer);
  203.     procedure WMFormSubmit(var Message: TMessage); message WM_FormSubmit;
  204.     procedure WMMouseScroll(var Message: TMessage); message WM_MouseScroll;
  205.     procedure SetSelLength(Value: LongInt);
  206.     procedure SetSelStart(Value: LongInt);
  207.     function GetSelLength: LongInt;
  208.     function GetSelText: string;
  209.     procedure SetNoSelect(Value: boolean);
  210.     procedure SetHistoryMaxCount(Value: integer);
  211.     procedure DrawBorder;
  212.     procedure DoHilite(X, Y: integer);
  213.     procedure SetScrollBars(Value: TScrollStyle);
  214.     procedure SetProcessing(Value: boolean);
  215.     function GetTarget: String;
  216.     {$ifdef ver100_plus}  {Delphi 3,4,5, C++Builder 3, 4}
  217.     procedure SetCharset(Value: TFontCharset);
  218.     {$endif}
  219.     function GetFormControlList: TList;
  220.     function GetNameList: TStringList;
  221.     function GetLinkList: TList;
  222.     procedure SetMarginWidth(Value: integer);
  223.     procedure SetMarginHeight(Value: integer);
  224.     procedure SetServerRoot(Value: string);
  225.     procedure SetOnObjectClick(Handler: TObjectClickEvent);
  226.     procedure FormControlEnterEvent(Sender: TObject);
  227.     procedure HandleMeta(Sender: TObject; const HttpEq, Name, Content: string);
  228.     procedure SetOptions(Value: ThtmlViewerOptions);
  229.     procedure DoImage(Sender: TObject; const SRC: string; var Stream: TMemoryStream);
  230.     procedure SetOnExpandName(Handler: TExpandNameEvent);
  231.     function GetWordAtCursor(X, Y: LongInt; var St, En: LongInt;
  232.                                             var AWord: string): boolean;
  233.     procedure HTMLTimerTimer(Sender: TObject);
  234.     procedure InitLoad;   
  235.  
  236.   protected
  237.     { Protected declarations }
  238.     PaintPanel: TPaintPanel;
  239.     BorderPanel: TPanel;
  240.     {$ifdef Win32}
  241.     VScrollBar: T32ScrollBar;
  242.     {$else}
  243.     VScrollBar: TScrollBar;
  244.     {$endif}
  245.     HScrollBar: TScrollBar;
  246.     Sel1: LongInt;
  247.     Visited: TStringList;     {visited URLs}
  248.  
  249.     procedure DoLogic;
  250.     procedure DoScrollBars;
  251.     procedure SetupAndLogic;
  252.     function GetURL(X, Y: integer; var UrlTarg: TUrlTarget;
  253.              var FormControl: TImageFormControlObj): boolean;
  254.     procedure KeyDown(var Key: Word; Shift: TShiftState); override;
  255.     function GetPalette: HPALETTE; override;
  256.     procedure HTMLPaint(Sender: TObject); virtual;
  257.     procedure HTMLMouseDown(Sender: TObject; Button: TMouseButton;
  258.       Shift: TShiftState; X, Y: Integer); virtual;
  259. {$ifdef ver120_plus}
  260.     procedure HTMLMouseWheel(Sender: TObject; Shift: TShiftState;
  261.       WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
  262. {$endif}
  263.     procedure HTMLMouseMove(Sender: TObject; Shift: TShiftState; X,
  264.       Y: Integer); virtual;
  265.     procedure HTMLMouseUp(Sender: TObject; Button: TMouseButton;
  266.       Shift: TShiftState; X, Y: Integer); virtual;
  267.     procedure HTMLMouseDblClk(Message: TWMMouse);
  268.     procedure URLAction; virtual;
  269.     function HotSpotClickHandled: boolean; dynamic;
  270.     procedure LoadFile(const FileName: string; ft: ThtmlFileType);
  271.     procedure PaintWindow(DC: HDC); override;
  272.     procedure UpdateImageCache;
  273.     procedure LoadTheStrings(Strings: TStrings; ft: ThtmlFileType);
  274.     procedure AddVisitedLink(const S: string);
  275.     procedure CheckVisitedLinks;
  276.  
  277.   public
  278.     { Public declarations }
  279.     FrameOwner: TObject;
  280.     FMarginHeightX, FMarginWidthX: integer;
  281.  
  282.     constructor Create(AOwner: TComponent); override;
  283.     destructor Destroy; override;
  284.     function HTMLExpandFilename(const Filename: string): string; virtual;
  285.     procedure LoadFromFile(const FileName: string);
  286.     procedure LoadTextFile(const FileName: string);
  287.     procedure LoadImageFile(const FileName: string);
  288.     procedure LoadStrings(Strings: TStrings);
  289.     procedure LoadTextStrings(Strings: TStrings);
  290.     procedure LoadFromBuffer(Buffer: PChar; BufSize: LongInt);
  291.     procedure LoadFromString(const S: string);    {!!}
  292.     procedure LoadFromStream(AStream: TStream);
  293.     procedure LoadStream(const URL: string; AStream: TMemoryStream; ft: ThtmlFileType);
  294.     function PositionTo(Dest: string): boolean;
  295.     function Find(const S: String; MatchCase: boolean): boolean;
  296.     procedure Clear; virtual;
  297.     procedure CopyToClipboard;
  298.     procedure SelectAll;
  299.     procedure ClearHistory;
  300.     procedure Reload;
  301.     procedure BumpHistory(const FileName, Title: string;
  302.                  OldPos: LongInt; ft: ThtmlFileType);
  303.     function GetSelTextBuf(Buffer: PChar; BufSize: LongInt): LongInt;
  304.     function InsertImage(const Src: string; Stream: TMemoryStream): boolean;
  305.     procedure DoEnter; override;
  306.     procedure DoExit; override;
  307.     procedure Repaint; override;
  308.     function FindSourcePos(DisplayPos: integer): integer;
  309.     function FindDisplayPos(SourcePos: integer; Prev: boolean): integer;
  310.     function DisplayPosToXy(DisplayPos: integer; var X, Y: integer): boolean;
  311.     function PtInObject(X, Y: integer; var Obj: TObject): boolean;  {X, Y, are client coord} {7.26}
  312.  
  313.     property DocumentTitle: string read GetTitle;
  314.     property URL: string read GetFURL;
  315.     property Base: string read GetBase write SetBase;
  316.     property BaseTarget: string read GetBaseTarget;
  317.     property Position: LongInt read GetPosition write SetPosition;
  318.     property VScrollBarPosition: integer read GetScrollPos write SetScrollPos;
  319.     property VScrollBarRange: integer read GetScrollBarRange;
  320.     property CurrentFile: string read GetCurrentFile;
  321.     property History: TStrings read FHistory;
  322.     property TitleHistory: TStrings read FTitleHistory;
  323.     property HistoryIndex: integer read FHistoryIndex write SetHistoryIndex;
  324.     property Processing: boolean read FProcessing;
  325.     property SelStart: LongInt read FCaretPos write SetSelStart;
  326.     property SelLength: LongInt read GetSelLength write SetSelLength;
  327.     property SelText: string read GetSelText;
  328.     property Target: string read GetTarget;
  329.     property Palette: HPalette read GetOurPalette write SetOurPalette;
  330.     property Dither: boolean read FDither write SetDither default True;
  331.     property CaretPos: LongInt read FCaretPos write SetCaretPos;
  332.     property FormControlList: TList read GetFormControlList;
  333.     property NameList: TStringList read GetNameList;
  334.     property LinkList: TList read GetLinkList;
  335.     property SectionList: TSectionList read FSectionList;
  336.     property OnExpandName: TExpandNameEvent read FOnExpandName write SetOnExpandName;
  337.  
  338.   published
  339.     { Published declarations }
  340.     property OnHotSpotCovered: THotSpotEvent read FOnHotSpotCovered
  341.              write FOnHotSpotCovered;
  342.     property OnHotSpotClick: THotSpotClickEvent read FOnHotSpotClick
  343.              write FOnHotSpotClick;
  344.     property OnImageRequest: TGetImageEvent read FOnImageRequest
  345.              write SetOnImageRequest;
  346.     property OnScript: TScriptEvent read FOnScript
  347.              write SetOnScript;
  348.     property OnFormSubmit: TFormSubmitEvent read FOnFormSubmit
  349.              write SetOnFormSubmit;
  350.     property OnHistoryChange: TNotifyEvent read FOnHistoryChange
  351.              write FOnHistoryChange;
  352.     property ViewImages: boolean read GetViewImages write SetViewImages default True;
  353.     property Enabled;
  354.     property TabStop;
  355.     property TabOrder;
  356.     property Align;
  357.     property Name;
  358.     property Tag;
  359.     property PopupMenu;
  360.     property ShowHint;
  361.     property Height default 150;
  362.     property Width default 150;
  363.     property DefBackground: TColor read FBackground write SetColor default clBtnFace;
  364.     property BorderStyle: THTMLBorderStyle read FBorderStyle write SetBorderStyle;
  365.     property Visible;
  366.     property HistoryMaxCount: integer read FHistoryMaxCount write SetHistoryMaxCount;
  367.     property DefFontName: TFontName read GetFontName write SetFontName;
  368.     property DefPreFontName: TFontName read GetPreFontName write SetPreFontName;
  369.     property DefFontSize: integer read FFontSize write SetFontSize default 12;
  370.     property DefFontColor: TColor read FFontColor write SetFontColor
  371.              default clBtnText;
  372.     property DefHotSpotColor: TColor read FHotSpotColor write SetHotSpotColor
  373.              default clBlue;
  374.     property DefVisitedLinkColor: TColor read FVisitedColor write SetVisitedColor
  375.              default clPurple;
  376.     property DefOverLinkColor: TColor read FOverColor write SetActiveColor
  377.              default clBlue;
  378.     property VisitedMaxCount: integer read FVisitedMaxCount write SetVisitedMaxCount default 50;
  379.     property ImageCacheCount: integer read FImageCacheCount
  380.                 write SetImageCacheCount default 5;
  381.     property NoSelect: boolean read FNoSelect write SetNoSelect;
  382.     property ScrollBars: TScrollStyle read FScrollBars write SetScrollBars default ssBoth;
  383.     {$ifdef ver100_plus}  {Delphi 3,4,5, C++Builder 3, 4}
  384.     property CharSet: TFontCharset read FCharSet write SetCharset;
  385.     {$endif}
  386.     property MarginHeight: integer read FMarginHeight write SetMarginHeight default 5;
  387.     property MarginWidth: integer read FMarginWidth write SetMarginWidth default 10;
  388.     property ServerRoot: string read FServerRoot write SetServerRoot;
  389.     property htOptions: ThtmlViewerOptions read FOptions write SetOptions;
  390.  
  391.     property OnMouseMove;
  392.     property OnMouseUp;
  393.     property OnMouseDown;
  394.     property OnKeyDown;
  395.     property OnKeyUp;
  396.     property OnKeyPress;
  397.     property OnEnter;
  398.     property OnProcessing: TProcessingEvent read FOnProcessing write FOnProcessing;
  399.     property OnInclude: TIncludeType read FOnInclude write FOnInclude;
  400.     property OnSoundRequest: TSoundType read FOnSoundRequest write FOnSoundRequest;
  401.     property OnMeta: TMetaType read FOnMeta write FOnMeta;
  402.     property OnMetaRefresh: TMetaRefreshType read FOnMetaRefresh write FOnMetaRefresh;
  403.     property OnImageClick: TImageClickEvent read FOnImageClick write FOnImageClick;
  404.     property OnImageOver: TImageOverEvent read FOnImageOver write FOnImageOver;
  405.     property OnObjectClick: TObjectClickEvent read FOnObjectClick write SetOnObjectClick;
  406.     property OnRightClick:  TRightClickEvent read FOnRightClick write FOnRightClick;
  407.     property OnMouseDouble: TMouseEvent read FOnMouseDouble write FOnMouseDouble;
  408.     property OnDragDrop: TDragDropEvent read GetDragDrop write SetDragDrop;
  409.     property OnDragOver: TDragOverEvent read GetDragOver write SetDragOver;
  410.     end;
  411.  
  412. procedure Register;
  413.  
  414. implementation
  415.